Covert Art
2021-07-18
knitr::opts_chunk$set(
warning=FALSE,
message=FALSE,
results = 'asis',
error = FALSE,
tidy = FALSE,
fig.show = "hold")
library(ggplot2)
library(dplyr)
set.seed(2020)Import data
tmp_path <- tempfile(fileext=".tsv.gz")
download.file("https://zenodo.org/record/4118676/files/COLOC_supp_table_all_results.tsv.gz?download=1",
tmp_path)
coloc <- data.table::fread(tmp_path)Subset the data
Only plot GWAS-QTL connections with colocalization probability (PP.H4) >= 80%.
disease_key <- c("SCZ"="Schizophrenia",
"AD"="Alzheimer's",
"BPD"="Bipolar",
"MS"="Multiple Sclerosis",
"PD"="Parkinson's")
coloc_top <- coloc %>%
dplyr::group_by(disease, GWAS, locus, QTL, type, cell_type) %>%
dplyr::slice_max(PP.H4.abf, n = 1) %>%
dplyr::group_by(disease, cell_type) %>%
dplyr::arrange(disease,GWAS, cell_type,QTL,locus) %>%
subset(PP.H4.abf >= .5) %>%
dplyr::mutate(disease=disease_key[disease],
cell_type=ifelse(QTL=="Microglia_all_regions_Young","Microglia",cell_type),
ID_GWAS=make.unique(paste(GWAS, locus,sep="_")),
ID_QTL=make.unique(paste(QTL, locus,sep="_"))) %>%
dplyr::ungroup() %>%
data.table::data.table()
data_long <- data.frame(coloc_top) %>%
dplyr::select(rowname=disease, key=cell_type, value=PP.H4.abf, QTL)
data_long <- data_long[complete.cases(data_long),]Create graph
Convert data to graph format.
#### Edges ####
edges <- coloc_top %>%
dplyr::select(from=ID_GWAS, to=ID_QTL, value=PP.H4.abf)
#### Vertices ####
vertices <- rbind(dplyr::select(coloc_top,
name=ID_GWAS,
dataset=GWAS,
group=disease,
locus) %>%
dplyr::mutate(type="GWAS"),
dplyr::select(coloc_top,
name=ID_QTL,
dataset=QTL,
group=cell_type,
locus)%>%
dplyr::mutate(type="cell_type")) %>%
unique()
#### Graph object ####
g <- igraph::graph.data.frame(d = edges,
vertices=vertices,
directed=FALSE)Setup fonts
# library(extrafont) ## Necessary to export fonts properly
# extrafont::font_import() # Only need to do once
# extrafont::loadfonts()
library(showtext)
# "Aldrich"
# "VT323"
# "Orbitron"
# "Crack Man"
# "Press Start 2P"
sysfonts::font_add_google("Press Start 2P")
# sysfonts::font_add("Crack Man",)circlize chord
# Libraries
library(tidyverse)
library(viridis)
library(patchwork)
library(hrbrthemes)
library(circlize)
library(chorddiag) #devtools::install_github("mattflor/chorddiag")
{
showtext::showtext.auto()
plot_name <- "circos_pacman.pdf"
# pdf(plot_name, width = 10, height = 10)
set.seed(2020)
# color palette
group_cols <- pals::gnuplot(n = dplyr::n_distinct(data_long$rowname) +
dplyr::n_distinct(data_long$key)+1)[-1]
names(group_cols) <- c(unique(data_long$rowname), unique(data_long$key))
gap.after <- setNames(rep(3, length(group_cols)), names(group_cols))
# gap.after["Monocytes"] <- 40
gap.after["Schizophrenia"] <- 70# 40
# unit.circle.segments <- c(rep(1, dplyr::n_distinct(data_long$rowname)),
# rep(.5,dplyr::n_distinct(data_long$key)))
# names(unit.circle.segments) <- c(unique(data_long$rowname), unique(data_long$key))
# parameters
circos.clear()
circos.par(start.degree = 180,#70,
gap.degree = .1,
track.margin = c(-0.1, 0.1),
points.overflow.warning = FALSE,
clock.wise=TRUE,
gap.after = gap.after
### Makes circle more or less angular
# unit.circle.segments = 500
)
### General plot parameters
par(mar = rep(0, 4),
bg = "black")
# Base plot
chordDiagram(
x = data_long,
scale = FALSE,
grid.col = group_cols,
# grid.border = "white",
transparency = 0.5,
directional = 1,
direction.type = c("arrows", "diffHeight"),
diffHeight = -0.04,
annotationTrack = "grid",
annotationTrackHeight = c(0.05, 0.1),
link.arr.type = "big.arrow",
link.sort = TRUE,
link.largest.ontop = TRUE,
link.target.prop= TRUE )
# abline(v = 0, lty = 2, col = "#00000080")
circos.track(sectors="Parkinson's",
x=mean(subset(data_long, rowname=="Parkinson's")$x),
ylim=c(0,1),
panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
sector.index = get.cell.meta.data("sector.index")
message(sector.index)
circos.points(
x=mean(xlim),
y=-1,
cex = if(sector.index=="Parkinson's") 15 else 0,
pch=16,
col = if(sector.index=="Parkinson's"){
rgb(1,1,1,.25)
} else {rgb(1,1,1,0)}
)
}
)
# Add text and axis
circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
sector.index = get.cell.meta.data("sector.index")
# Add names to the sector.
circos.text(
x = mean(xlim),
y = 1.5,
labels = gsub(""," ",sector.index),
facing = "bending",
niceFacing = TRUE,
cex = .5,
col = "white",
font=1,
family="Press Start 2P"
)
# Add graduation on axis
circos.axis(
h = "top",
# col = "white",
labels= FALSE,
major.tick = TRUE,
major.at = seq(from = 0, to = xlim[2],
by = ifelse(test = xlim[2]>10, yes = 4, no = 2)),
minor.ticks = 0,
major.tick.percentage = 0.5,
labels.niceFacing = FALSE)
}
)
# dev.off()
}
circlize scatter
library(circlize)
data <- coloc_top
data$factor <- data$GWAS
data$x <- data$GWAS_pos
data$y <- data$PP.H4.abf
group_cols <- pals::alphabet(n = dplyr::n_distinct(data$factor))
{
circos.clear()
#Initialize the plot.
par(mar = c(1, 1, 1, 1) )
circos.initialize(factors = data$factor, x = data$x )
#### TRACK 1 ####
# Build the regions of track #1
circos.trackPlotRegion(factors = data$factor,
y=data$y,
panel.fun = function(x, y) {
circos.axis(labels.cex=0.5, labels.font=1, lwd=0.8)
}
)
# --> Add a scatterplot on it:
circos.trackPoints(data$factor, data$x, data$y, col = group_cols, pch=20)
#### TRACK 2 ####
# Build the regions of track #2:
circlize::circos.trackPlotRegion(factors = data$factor, y=data$y, panel.fun = function(x, y) {
circos.axis(labels=FALSE, major.tick=FALSE)
})
# --> Add a scatterplot on it
circos.trackPoints(data$factor, data$x, data$y, col = rgb(0.9,0.5,0.8,0.3), pch=20, cex=2)
#### TRACK 3 ####
# Add track #3 --> don't forget you can custom the height of tracks!
circos.par("track.height" = 0.4)
circos.trackPlotRegion(factors = data$factor, y=data$y, panel.fun = function(x, y) {
circos.axis(labels=FALSE, major.tick=FALSE)
})
circos.trackLines(data$factor, data$x, data$y, col = rgb(0.9,0.5,0.1,0.3), pch=20, cex=2, type="h")
# and continue as long as needed!
}
ggraph
# Libraries
library(tidyverse)
library(viridis)
library(patchwork)
library(hrbrthemes)
library(ggraph)
library(igraph)
# The flare dataset is provided in ggraph
# vertices <- flare$vertices %>% arrange(name) %>% mutate(name=factor(name, name))
connections <- subset(edges, value>.9)
# Preparation to draw labels properly:
vertices$id=NA
myleaves=which(is.na( match(vertices$name, edges$from) ))
nleaves=length(myleaves)
vertices$id[ myleaves ] = seq(1:nleaves)
vertices$angle= 90 - 360 * vertices$id / nleaves
vertices$hjust<-ifelse( vertices$angle < -90, 1, 0)
vertices$angle<-ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)
# Build a network object from this dataset:
mygraph <- graph_from_data_frame(edges, vertices = vertices)
# The connection object must refer to the ids of the leaves:
from = match( connections$from, vertices$name)
to = match( connections$to, vertices$name)
# Make the plot
ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
geom_conn_bundle(data = get_con(from = from, to = to), alpha = 0.1, colour="#69b3a2") +
ggraph::geom_edge_density() +
geom_node_text(aes(x = x*1.01, y=y*1.01, filter = leaf, label=group, angle = angle, hjust=hjust), size=1.5, alpha=1) +
coord_fixed() +
theme_void() +
theme(
legend.position="none",
plot.margin=unit(c(0,0,0,0),"cm"),
) +
expand_limits(x = c(-1.2, 1.2), y = c(-1.2, 1.2))edgebundleR
library(edgebundleR)
edgebundle(g)Session Info
utils::sessionInfo()R version 4.1.0 (2021-05-18) Platform: x86_64-apple-darwin17.0 (64-bit) Running under: macOS Big Sur 10.16
Matrix products: default BLAS: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.dylib LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
locale: [1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8
attached base packages: [1] stats graphics grDevices utils datasets methods base
other attached packages: [1] chorddiag_0.1.3 circlize_0.4.13 hrbrthemes_0.8.0 patchwork_1.1.1
[5] viridis_0.6.1 viridisLite_0.4.0 forcats_0.5.1 stringr_1.4.0
[9] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2
[13] tidyverse_1.3.1 showtext_0.9-2 showtextdb_3.0 sysfonts_0.8.3
[17] dplyr_1.0.7 ggplot2_3.3.5
loaded via a namespace (and not attached): [1] fs_1.5.0 lubridate_1.7.10 httr_1.4.2
[4] tools_4.1.0 backports_1.2.1 bslib_0.2.5.1
[7] utf8_1.2.1 R6_2.5.0 DBI_1.1.1
[10] colorspace_2.0-2 withr_2.4.2 tidyselect_1.1.1
[13] gridExtra_2.3 curl_4.3.2 compiler_4.1.0
[16] extrafontdb_1.0 cli_3.0.0 rvest_1.0.0
[19] xml2_1.3.2 sass_0.4.0 scales_1.1.1
[22] systemfonts_1.0.2 digest_0.6.27 rmarkdown_2.9
[25] R.utils_2.10.1 dichromat_2.0-0 pkgconfig_2.0.3
[28] htmltools_0.5.1.1 extrafont_0.17 dbplyr_2.1.1
[31] highr_0.9 maps_3.3.0 rlang_0.4.11
[34] GlobalOptions_0.1.2 readxl_1.3.1 pals_1.7
[37] rstudioapi_0.13 shape_1.4.6 jquerylib_0.1.4
[40] generics_0.1.0 jsonlite_1.7.2 R.oo_1.24.0
[43] magrittr_2.0.1 Rcpp_1.0.7 munsell_0.5.0
[46] fansi_0.5.0 gdtools_0.2.3 lifecycle_1.0.0
[49] R.methodsS3_1.8.1 stringi_1.7.2 yaml_2.2.1
[52] grid_4.1.0 crayon_1.4.1 haven_2.4.1
[55] mapproj_1.2.7 hms_1.1.0 knitr_1.33
[58] pillar_1.6.1 igraph_1.2.6 reprex_2.0.0
[61] glue_1.4.2 evaluate_0.14 data.table_1.14.0
[64] modelr_0.1.8 vctrs_0.3.8 Rttf2pt1_1.3.8
[67] cellranger_1.1.0 gtable_0.3.0 assertthat_0.2.1
[70] xfun_0.24 broom_0.7.8 ellipsis_0.3.2